home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / src / PlugIns.p < prev    next >
Encoding:
Text File  |  1997-01-24  |  27.8 KB  |  1,038 lines  |  [TEXT/CWIE]
  1. unit PlugIns;
  2. {This unit for utilizing Adobe Photoshop compatible acquisition, export and filter plug-ins}
  3. {is based on code written by Greg Brown, Steven Gonzalo and Richard Ohlendorf.}
  4. {Ohlendorf Research, Inc.}
  5. {818 LaSalle Street}
  6. {Ottawa, IL 61350}
  7. {815-434-5622}
  8. {Applelink--Abraham@AppleLink.com}
  9.  
  10. interface
  11.     uses
  12.         Types, Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources,
  13.         Errors, Palettes, QDOffscreen, StandardFile, MixedMode, Files, Windows,
  14.         Globals, utilities, Graphics, Lut, Filters, Stacks, File1, File2;
  15.  
  16.     procedure RunAcqPlugIn (item: integer);
  17.     procedure LoadAcqPlugIn (FileName: str255);
  18.     procedure RunExportPlugIn (item: integer);
  19.     procedure LoadExportPlugIn (FileName: str255);
  20.     procedure RunFilterPlugIn (item: integer);
  21.     procedure LoadFilterPlugIn (FileName: str255);
  22.     {$ifc PowerPC}
  23.     procedure CallCode(selector: integer; stuff: ptr; var data: LongInt; var result: Integer; codePtr: UniversalProcPtr); external; {Glue.c}
  24.     {$endc}
  25.  
  26.  
  27. implementation
  28.  
  29.     const
  30.         uppCallCodeInfo = $00003F80; { PROCEDURE (2 byte param, 4 byte param, 4 byte param, 4 byte param); }
  31.         uppTestAbortProcInfo = $00000010; { FUNCTION : 1 byte result; }
  32.         uppUpdateProgressProcInfo = $000003C0; { PROCEDURE (4 byte param, 4 byte param); }
  33.         
  34.     type
  35.         PluginCodeType=procedure(selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer);
  36.  
  37.         MonitorRec = record
  38.                 gamma: Fixed;
  39.                 redX: Fixed;
  40.                 redY: Fixed;
  41.                 greenX: Fixed;
  42.                 greenY: Fixed;
  43.                 blueX: Fixed;
  44.                 blueY: Fixed;
  45.                 whiteX: Fixed;
  46.                 whiteY: Fixed;
  47.                 ambient: Fixed;
  48.             end;
  49.  
  50.         PlaneMapType = array[0..15] of integer;
  51.  
  52.         AcquireRecord = record
  53.                 serialNumber: LongInt;
  54.                 abortProc: ProcPtr;
  55.                 progressProc: ProcPtr;
  56.                 maxData: LongInt;
  57.                 imageMode: integer;
  58.                 fImageSize: Point;
  59.                 depth: integer;
  60.                 planes: integer;
  61.                 imageHRes: Fixed;
  62.                 imageVRes: Fixed;
  63.                 rLUT: packed array[0..255] of char;
  64.                 gLUT: packed array[0..255] of char;
  65.                 bLUT: packed array[0..255] of char;
  66.                 data: Ptr;
  67.                 theRect: Rect;
  68.                 loPlane: integer;
  69.                 hiPlane: integer;
  70.                 colBytes: integer;
  71.                 rowBytes: LongInt;
  72.                 planeBytes: LongInt;
  73.                 FileName: Str255;
  74.                 vRefNum: integer;
  75.                 dirty: boolean;
  76.          {Version 4 fields}
  77.                 hostSig: OSType;
  78.                 hostProc: ProcPtr;
  79.                 hostModes: LongInt;
  80.                 planeMap: PlaneMapType;
  81.                 canTranspose: boolean;
  82.                 needTranspose: boolean;
  83.                 duotoneInfo: Handle;
  84.                 diskSpace: LongInt;
  85.                 spaceProc: ProcPtr;
  86.                 monitor: MonitorRec;
  87.                 reserved: packed array[0..255] of char;
  88.             end;
  89.  
  90.         FilterColor = packed array[0..3] of char;
  91.  
  92.         FilterRecord = record
  93.                 serialNumber: LongInt;
  94.                 abortProc: ProcPtr;
  95.                 progressProc: ProcPtr;
  96.                 parameters: Handle;
  97.                 fImageSize: Point;
  98.                 planes: integer;
  99.                 filterRect: Rect;
  100.                 background: RGBColor;
  101.                 foreground: RGBColor;
  102.                 maxSpace: LongInt;
  103.                 bufferSpace: LongInt;
  104.                 inRect: Rect;
  105.                 inLoPlane: integer;
  106.                 inHiPlane: integer;
  107.                 outRect: Rect;
  108.                 outLoPlane: integer;
  109.                 outHiPlane: integer;
  110.                 inData: Ptr;
  111.                 inRowBytes: LongInt;
  112.                 outData: Ptr;
  113.                 outRowBytes: LongInt;
  114.                 isFloating: boolean;
  115.                 haveMask: boolean;
  116.                 autoMask: boolean;
  117.                 maskRect: Rect;
  118.                 maskData: Ptr;
  119.                 maskRowBytes: LongInt;
  120.          {Version 4 fields}
  121.                 backColor: FilterColor;
  122.                 foreColor: FilterColor;
  123.                 hostSig: OSType;
  124.                 hostProc: ProcPtr;
  125.                 imageMode: integer;
  126.                 imageHRes: Fixed;
  127.                 imageVRes: Fixed;
  128.                 floatCoord: Point;
  129.                 wholeSize: Point;
  130.                 monitor: MonitorRec;
  131.                 reserved: packed array[0..255] of char;
  132.             end;
  133.  
  134.  
  135.         ExportRecord = record
  136.                 serialNumber: LongInt;
  137.                 abortProc: ProcPtr;
  138.                 progressProc: ProcPtr;
  139.                 maxData: LongInt;
  140.                 imageMode: integer;
  141.                 eImageSize: Point;
  142.                 depth: integer;
  143.                 planes: integer;
  144.                 imageHRes: Fixed;
  145.                 imageVRes: Fixed;
  146.                 rLUT: packed array[0..255] of char;
  147.                 gLUT: packed array[0..255] of char;
  148.                 bLUT: packed array[0..255] of char;
  149.                 theRect: Rect;
  150.                 loPlane: integer;
  151.                 hiPlane: integer;
  152.                 data: Ptr;
  153.                 rowBytes: LongInt;
  154.                 filename: Str255;
  155.                 vRefNum: integer;
  156.                 dirty: BOOLEAN;
  157.                 selectBBox: Rect;
  158.         {Version 4 fields }
  159.                 hostSig: OSType;
  160.                 hostProc: ProcPtr;
  161.                 duotoneInfo: Handle;
  162.                 thePlane: integer;
  163.                 monitor: MonitorRec;
  164.                 reserved: packed array[0..255] of char;
  165.             end;
  166.  
  167.  
  168.     var
  169.         acqData, exportData, filterData, nlines, rowpix: LongInt;
  170.         disppict, srcpict: ptr;
  171.         refnum: integer;
  172.         ShowProgress: boolean;
  173.         ProgressMsg: string[17];
  174.         FilterRec: FilterRecord;
  175.         PluginCode:PluginCodeType;
  176.  
  177.  
  178.     procedure DummyProc;
  179.     begin
  180.     end;
  181.  
  182.     function TestAbort: boolean;
  183.     begin
  184.         if commandperiod then
  185.             testabort := true
  186.         else
  187.             testabort := false;
  188.     end;
  189.  
  190.  
  191.     procedure UpdateProgress (done, total: LongInt);
  192.         var
  193.             whatpercent: integer;
  194.     begin
  195.         if ShowProgress and (done > 0) and (total > 0) and (total >= done) then begin
  196.                 whatpercent := round((done / total) * 100);
  197.                 UpdateMeter(whatpercent, ProgressMsg);
  198.             end;
  199.     end;
  200.  
  201.  
  202.  
  203.     procedure CopyData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes: LongInt; lines: integer);
  204.         var
  205.             i: integer;
  206.             dst: ptr;
  207.             width: LongInt;
  208.     begin
  209.         with theRect do
  210.             width := right - left;
  211.         with info^ do
  212.             dst := ptr(ord4(PicBaseAddr) + therect.top * BytesPerRow + therect.left);
  213.         for i := 0 to lines - 1 do begin
  214.                 BlockMove(src, dst, width);
  215.                 src := ptr(ord4(src) + srcRowBytes);
  216.                 dst := ptr(ord4(dst) + dstRowBytes);
  217.             end;
  218.     end;
  219.  
  220.  
  221.     procedure CopyInterleavedRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, colBytes: LongInt; lines: integer; planeMap: PlaneMapType);
  222.         var
  223.             i, j, slice, plane, width: integer;
  224.             src2, src3, dst2, dst3: ptr;
  225.     begin
  226.         with theRect do
  227.             width := right - left;
  228.         with info^.StackInfo^ do
  229.             for slice := 1 to 3 do begin
  230.                     CurrentSlice := slice;
  231.                     SelectSlice(slice);
  232.                     plane := planeMap[slice - 1];
  233.                     src2 := src;
  234.                     dst2 := ptr(ord4(info^.PicBaseAddr) + therect.top * info^.BytesPerRow + therect.left);
  235.                     for i := 0 to lines - 1 do begin
  236.                             src3 := ptr(ord4(src2) + plane);
  237.                             dst3 := dst2;
  238.                             for j := 0 to width - 1 do begin
  239.                                     dst3^ := src3^;
  240.                                     src3 := ptr(ord4(src3) + colBytes);
  241.                                     dst3 := ptr(ord4(dst3) + 1);
  242.                                 end;
  243.                             src2 := ptr(ord4(src2) + srcRowBytes);
  244.                             dst2 := ptr(ord4(dst2) + dstRowBytes);
  245.                         end; {for i:=1 to nlines-1}
  246.                 end; {for slice:=1 to 3}
  247.     end;
  248.  
  249.  
  250.     procedure CopyPlanarRGBData (src: ptr; theRect: rect; srcRowBytes, dstRowBytes, planeBytes: LongInt; lines, loPlane, hiPlane: integer);
  251.         var
  252.             i, j, slice, plane: integer;
  253.             src2, dst2: ptr;
  254.             width: LongInt;
  255.     begin
  256.         with theRect do
  257.             width := right - left;
  258.         if loPlane = hiPlane then
  259.             planeBytes := 0;
  260.         if (planeBytes < 0) or (planeBytes > srcRowBytes) then
  261.             planeBytes := width;
  262.         with info^.StackInfo^ do
  263.             for plane := loPlane to hiPlane do begin
  264.                     slice := plane + 1;
  265.                     if slice > 3 then
  266.                         slice := 3;
  267.                     CurrentSlice := slice;
  268.                     SelectSlice(slice);
  269.                     src2 := ptr(ord4(src) + planeBytes * plane);
  270.                     dst2 := ptr(ord4(info^.PicBaseAddr) + therect.top * info^.BytesPerRow + therect.left);
  271.                     for i := 0 to lines - 1 do begin
  272.                             BlockMove(src2, dst2, width);
  273.                             src2 := ptr(ord4(src2) + srcRowBytes);
  274.                             dst2 := ptr(ord4(dst2) + dstRowBytes);
  275.                         end;
  276.                 end;
  277.     end;
  278.  
  279.  
  280.     function MakeRGBStack (name: str255; width, height: integer): boolean;
  281.         var
  282.             ignore: integer;
  283.     begin
  284.         MakeRGBStack := false;
  285.         if not NewPicWindow('RGB', width, height) then
  286.             exit(MakeRGBStack);
  287.         if not MakeStackFromWindow then
  288.             exit(MakeRGBStack);
  289.         if not AddSlice(false) then begin
  290.                 info^.changes := false;
  291.                 ignore := CloseAWindow(info^.wptr);
  292.                 exit(MakeRGBStack);
  293.             end;
  294.         if not AddSlice(false) then begin
  295.                 info^.changes := false;
  296.                 ignore := CloseAWindow(info^.wptr);
  297.                 exit(MakeRGBStack);
  298.             end;
  299.         MakeRGBStack := true;
  300.     end;
  301.  
  302.     procedure GetSFCurDir (var vRefNum: integer; var DirID: LongInt);
  303.   {From "Inside Macintosh:Files", page 3-31.}
  304.         type
  305.             IntPtr = ^integer;
  306.             LongIntPtr = ^LongInt;
  307.         const
  308.             SFSaveDisk = $214;
  309.             CurDirStore = $398;
  310.     begin
  311.         vRefNum := -IntPtr(SFSaveDisk)^;
  312.         DirID := LongIntPtr(CurDirStore)^;
  313.     end;
  314.  
  315.     procedure SetSFCurDir (vRefNum: integer; DirID: LongInt);
  316.         type
  317.             IntPtr = ^integer;
  318.             LongIntPtr = ^LongInt;
  319.         const
  320.             SFSaveDisk = $214;
  321.             CurDirStore = $398;
  322.     begin
  323.         IntPtr(SFSaveDisk)^ := -vRefNum;
  324.         LongIntPtr(CurDirStore)^ := dirID;
  325.     end;
  326.  
  327.  
  328.     function isSystem7: boolean;
  329.     begin
  330.         if not System7 then {These routines uses File Manager calls only available under System 7.}
  331.             PutError('System 7 required to use plug-ins.');
  332.         isSystem7 := System7;
  333.     end;
  334.  
  335.  
  336.     procedure LoadCodeResource (FileName: str255; fType: osType; var codePtr: ProcPtr);
  337.         var
  338.             myReply: StandardFileReply;
  339.             myTypes: SFTypeList;
  340.             err: OSErr;
  341.             CodeResource: handle;
  342.             GotSpec: boolean;
  343.             spec: FSSpec;
  344.             SaveVol: integer;
  345.             SaveDir: LongInt;
  346.     begin
  347.         GotSpec := false;
  348.         if FileName <> '' then begin
  349.                 err := FSMakeFSSpec(PluginsVRefNum, PluginsDirID, FileName, spec);
  350.                 GotSpec := err = noerr;
  351.             end;
  352.         if not GotSpec then begin
  353.                 GetSFCurDir(SaveVol, SaveDir);
  354.                 if PluginsVRefNum <> 0 then
  355.                     SetSFCurDir(PluginsVRefNum, PluginsDirID);
  356.                 myTypes[0] := fType;
  357.                 StandardGetFile(nil, 1, @myTypes, myReply);
  358.                 if myReply.sfGood then begin
  359.                         spec := myReply.sfFile;
  360.                         FileName := myReply.sfFile.name;
  361.                         GotSpec := true
  362.                     end;
  363.                 GetSFCurDir(PluginsVRefNum, PluginsDirID);
  364.                 SetSFCurDir(SaveVol, SaveDir);
  365.             end;
  366.         if GotSpec then begin
  367.                 refnum := FSpOpenResFile(spec, fsCurPerm);
  368.                 if (refnum <> -1) then begin
  369.                         if fType = '8BAM' then begin {Acquistion plug-in}
  370.                                 if pos('Raster', FileName) <> 0 then {Can't show progress indicator if RasterOps frame grabber.}
  371.                                     ShowProgress := false;
  372.                                 if FileName <> LastAcqPlugIn then
  373.                                     acqData := 0;
  374.                                 LastAcqPlugIn := FileName;
  375.                             end
  376.                         else if fType = '8BFM' then begin  {Filter plug-in}
  377.                                 if FileName <> LastFilterPlugIn then begin
  378.                                         filterData := 0;
  379.                                         FilterRec.parameters := nil;
  380.                                     end;
  381.                                 LastFilterPlugIn := FileName;
  382.                             end
  383.                         else if fType = '8BEM' then begin  {Export plug-in}
  384.                                 if FileName <> LastExportPlugIn then
  385.                                     exportData := 0;
  386.                                 LastExportPlugIn := FileName;
  387.                             end;
  388.                         UseResFile(refnum);
  389.                         codeResource := GetIndResource(fType, 1);
  390.                         hlock(codeResource);
  391.                         codePtr := ProcPtr(codeResource^);
  392.                     end
  393.                 else
  394.                     PutError(concat('Error opening plug-in. (Code=', Long2Str(ResError), ')'));
  395.             end;
  396.     end;
  397.  
  398.  
  399. {$ifc not PowerPC}
  400. procedure CallCode (selector: integer; AcqRec: ptr; var data: LongInt; var result: Integer; codePtr: ptr);
  401.     inline
  402.         $205F,   {move.l (a7)+,a0}
  403.         $4E90;   {jsr (a0)}
  404. {$endc}
  405. {Otherwise use C glue routine ("Glue.c") that calls CallUniversalProc. We can't
  406.  call it directly because CallUniversalProc uses a variable number of arguments.}
  407.  
  408.  
  409.     procedure LoadAcqPlugIn (FileName: str255);
  410.  
  411.         const
  412.             AcquireAbout = 0;
  413.             AcquireStart = 1;
  414.             AcquireContinue = 2;
  415.             AcquireFinish = 3;
  416.             AcquirePrepare = 4;
  417.  
  418.             BitMapMode = 0;
  419.             GrayScaleMode = 1;
  420.             IndexedColorMode = 2;
  421.             RGBColorMode = 3;
  422.  
  423.         var
  424.             thiserror: qderr;
  425.             codePtr: ProcPtr;
  426.             AcqRec: acquirerecord;
  427.             result, i, selector, width, height, ignore: integer;
  428.             ok, PlugInDigitizer: boolean;
  429.             dst: ptr;
  430.             name: str255;
  431.  
  432.         procedure ShowInfo (str: str255);
  433.         begin
  434.             with AcqRec do
  435.                 if ControlKeyDown then begin
  436.                         str := concat(str, crStr, crStr, 'imageMode=', long2str(imageMode));
  437.                         str := concat(str, crStr, 'width=', long2str(therect.right - therect.left));
  438.                         str := concat(str, crStr, 'height=', long2str(therect.bottom - therect.top));
  439.                         str := concat(str, crStr, 'depth=', long2str(depth));
  440.                         str := concat(str, crStr, 'planes=', long2str(planes));
  441.                         str := concat(str, crStr, 'colBytes=', long2str(colBytes));
  442.                         str := concat(str, crStr, 'rowBytes=', long2str(rowBytes));
  443.                         str := concat(str, crStr, 'planeBytes=', long2str(planeBytes));
  444.                         str := concat(str, crStr, 'planeMap=', long2str(planeMap[0]), ' ', long2str(planeMap[1]), long2str(planeMap[2]), ' ', long2str(planeMap[3]));
  445.                         str := concat(str, crStr, 'loPlane=', long2str(loPlane));
  446.                         str := concat(str, crStr, 'hiPlane=', long2str(hiPlane));
  447.                         ShowMessage(str);
  448.                         wait(30);
  449.                     end;
  450.         end;
  451.  
  452.         procedure CopyLUT;
  453.             var
  454.                 i: integer;
  455.         begin
  456.             with info^ do begin
  457.                     for i := 0 to 255 do
  458.                         with cTable[i], cTable[i].rgb, AcqRec do begin
  459.                                 value := 0;
  460.                                 red := bsl(ord(rLUT[255 - i]), 8);
  461.                                 green := bsl(ord(gLUT[255 - i]), 8);
  462.                                 blue := bsl(ord(bLUT[255 - i]), 8);
  463.                             end;
  464.                     LoadLUT(cTable);
  465.                     SetupPseudocolor;
  466.                     LutMode := ColorLUT;
  467.                     IdentityFunction := false;
  468.                     UpdateMap;
  469.                 end
  470.         end;
  471.  
  472.         procedure abort (error: integer; started: boolean);
  473.             var
  474.                 msg: str255;
  475.         begin
  476.             if started then
  477.                 CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr);
  478.             CloseResFile(RefNum);
  479.             if MeterWindow <> nil then begin
  480.                     DisposeWindow(MeterWindow);
  481.                     MeterWindow := nil;
  482.                 end;
  483.             if error < 0 then begin
  484.                     msg := '';
  485.                     if error = -108 then
  486.                         msg := concat(crStr, crStr, '"', 'Not enough memory', '"');
  487.                     PutError(concat('Plug-in error (result code=', long2str(error), ')', msg));
  488.                 end;
  489.             PicLeft := PicLeftBase;
  490.             PicTop := PicTopBase;
  491.             AbortMacro;
  492.             {exit(LoadAcqPlugIn);} {ppc-bug}
  493.         end;
  494.  
  495.     begin
  496.         if not isSystem7 then
  497.             exit(LoadAcqPlugIn);
  498.         PlugInDigitizer := pos('Plug-in', FileName) <> 0;
  499.         ShowProgress := true;
  500.         codePtr := nil;
  501.         LoadCodeResource(FileName, '8BAM', codePtr);
  502.         if codePtr = nil then
  503.             exit(LoadAcqPlugIn);
  504.         if TestAbortProc=nil then
  505.             TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA);
  506.         if UpdateProgressProc=nil then 
  507.             UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA);
  508.         with AcqRec do begin
  509.                 SerialNumber := 12345;
  510.                 AbortProc := TestAbortProc;
  511.                 ProgressProc := UpdateProgressProc;
  512.                 MaxData := maxBlock div 2;
  513.                 if MaxData < 25000 then begin
  514.                         PutError('Out of memory.');
  515.                         abort(0, false);
  516.                         exit(LoadAcqPlugIn)
  517.                     end;
  518.                 imageHRes := 0;
  519.                 hostSig := 'Imag';
  520.                 hostProc := nil {@DummyProc};
  521.                 hostModes := 14;{=1110, i.e., grayscale, indexed color and RGB}
  522.                 for i := 0 to 15 do begin
  523.                         planemap[i] := i;
  524.                     end;
  525.                 FileName := '';
  526.                 canTranspose := false;
  527.                 needTranspose := false;
  528.                 duoToneInfo := nil;
  529.                 diskSpace := -1;
  530.                 spaceProc := nil;
  531.                 monitor.gamma := 0;
  532.                 for i := 0 to 255 do
  533.                     reserved[i] := chr(0);
  534.             end;
  535.         ProgressMsg := 'Acquiring Image…';
  536.         ShowInfo('Acquire');
  537.         CallCode(AcquirePrepare, @AcqRec, acqData, result, codePtr);
  538.         if (result <> 0) then
  539.             begin abort(result, false); exit(LoadAcqPlugIn) end;
  540.         ShowInfo('start');
  541.         CallCode(AcquireStart, @AcqRec, acqData, result, codePtr);{call main dialog box etc.}
  542.         if (result <> 0) then
  543.             begin abort(result, false); exit(LoadAcqPlugIn) end;
  544.         if AcqRec.depth = 1 then begin
  545.                 PutError('NIH Image does not support acquisition of bitmap (black and white) images.');
  546.                 abort(0, true);
  547.                 exit(LoadAcqPlugIn)
  548.             end;
  549.         ShowInfo('Opening');
  550.         OpeningPlugInWindow := true; {Causes MakeNewWindow to open window offscreen.}
  551.         if AcqRec.ImageMode = RGBColorMode then
  552.             ok := MakeRGBStack('Untitled', AcqRec.fImageSize.h, AcqRec.fImageSize.v)
  553.         else begin
  554.                 if FileName <> '' then
  555.                     name := FileName
  556.                 else
  557.                     name := 'Untitled';
  558.                 ok := NewPicWindow(name, AcqRec.fImageSize.h, AcqRec.fImageSize.v);
  559.             end;
  560.         OpeningPlugInWindow := false;
  561.         if not ok then begin
  562.                 ShowInfo('Aborting');
  563.                 abort(0, true);
  564.                 exit(LoadAcqPlugIn)
  565.             end;
  566.         with info^, AcqRec do
  567.             if ImageMode = GrayScaleMode then begin
  568.                     if LUTMode = ColorLUT then
  569.                         ResetGrayMap
  570.                 end
  571.             else if ImageMode = RGBColorMode then
  572.                 ResetGrayMap
  573.             else if ImageMode = IndexedColorMode then begin
  574.                     ShowInfo('CopyLUT');
  575.                     CopyLUT;
  576.                 end;
  577.         ShowWatch;
  578.         ShowInfo('Continue');
  579.         repeat
  580.             CallCode(AcquireContinue, @AcqRec, acqData, result, codePtr);
  581.             if result <> 0 then begin
  582.                     info^.changes := false;
  583.                     ignore := CloseAWindow(info^.wptr);
  584.                     abort(result, true);
  585.                     exit(LoadAcqPlugIn)
  586.                 end;
  587.             with AcqRec do
  588.                 if data <> nil then begin
  589.                         width := therect.right - therect.left;
  590.                         height := therect.bottom - therect.top;
  591.                         with Info^ do
  592.                             if ((therect.left + width) <= PixelsPerLine) and (therect.top < nlines) then begin
  593.                                     if (ImageMode = RGBColorMode) and (planes >= 3) and ((hiPlane - loPlane) < 3) then begin
  594.                                             if planeBytes = 1 then
  595.                                                 CopyInterleavedRGBData(data, theRect, rowBytes, Info^.BytesPerRow, colBytes, height, planeMap)
  596.                                             else
  597.                                                 CopyPlanarRGBData(data, theRect, rowBytes, Info^.BytesPerRow, planeBytes, height, loPlane, hiPlane)
  598.                                         end
  599.                                     else
  600.                                         CopyData(data, theRect, rowBytes, Info^.BytesPerRow, height);
  601.                                 end;
  602.                     end;
  603.         until (result <> 0) or (AcqRec.data = nil);
  604.         ShowInfo('Finish');
  605.         CallCode(AcquireFinish, @AcqRec, acqData, result, codePtr);
  606.         CloseResFile(RefNum);
  607.         if MeterWindow <> nil then begin
  608.                 DisposeWindow(MeterWindow);
  609.                 MeterWindow := nil;
  610.             end;
  611.         MoveWindow(info^.wptr, PicLeft, PicTop, true);
  612.         if (AcqRec.imageHRes <> 0) and (not PlugInDigitizer) then
  613.             with info^ do begin
  614.                     xScale := FixRound(AcqRec.imageHRes);
  615.                     yScale := xScale;
  616.                     PixelAspectRatio := 1.0;
  617.                     xUnit := 'inch';
  618.                     SpatiallyCalibrated := true;
  619.                     UpdateTitleBar;
  620.                 end;
  621.         if info^.StackInfo <> nil then
  622.             with info^.StackInfo^ do begin
  623.                     for i := nSlices downto 1 do begin
  624.                             CurrentSlice := i;
  625.                             SelectSlice(CurrentSlice);
  626.                             InvertPic;
  627.                         end;
  628.                     StackType := rgbStack;
  629.                     UpdateTitleBar;
  630.                     ConvertRGBToEightBitColor(true);
  631.                 end
  632.         else
  633.             InvertPic;
  634.         if AcqRec.ImageMode = IndexedColorMode then begin
  635.                 FixColors;
  636.                 WhatToUndo := NothingToUndo;
  637.             end;
  638.         Info^.changes := true;
  639.     end; {LoadAcqPlugIn}
  640.  
  641.  
  642.     procedure PutPlugInMsg (str: str255);
  643.         var
  644.             str2: str255;
  645.     begin
  646.         if System7 then
  647.             PutError(concat(str, ' plug-ins found'))  {Code Warrior bug}
  648.         else
  649.             PutError('System 7 required to use plug-ins.');
  650.     end;
  651.  
  652.  
  653.     procedure RunAcqPlugIn (item: integer);
  654.         var
  655.             name: str255;
  656.     begin
  657.         if nAcqPlugIns = 0 then begin
  658.                 PutPlugInMsg('No acquisition');
  659.                 exit(RunAcqPlugIn);
  660.             end;
  661.         GetMenuItemText(AcquireMenuH, item, name);
  662.         LoadAcqPlugIn(name);
  663.     end;
  664.  
  665.  
  666.     procedure LoadExportPlugIn (FileName: str255);
  667.  
  668.         const
  669.             ExportAbout = 0;
  670.             ExportStart = 1;
  671.             ExportContinue = 2;
  672.             ExportFinish = 3;
  673.             ExportPrepare = 4;
  674.  
  675.             BitMapMode = 0;
  676.             GrayScaleMode = 1;
  677.             IndexedColorMode = 2;
  678.             RGBColorMode = 3;
  679.  
  680.         var
  681.             thiserror: qderr;
  682.             codePtr: ProcPtr;
  683.             ExportRec: ExportRecord;
  684.             result, i, selector, width, height: integer;
  685.             ok: boolean;
  686.             dst: ptr;
  687.             roi, empty: rect;
  688.             offset: LongInt;
  689.  
  690.         procedure ShowInfo (str: str255);
  691.         begin
  692.             with ExportRec do
  693.                 if ControlKeyDown then begin
  694.                         str := concat(str, crStr, crStr, 'imageMode=', long2str(imageMode));
  695.                         str := concat(str, crStr, 'width=', long2str(therect.right - therect.left));
  696.                         str := concat(str, crStr, 'height=', long2str(therect.bottom - therect.top));
  697.                         str := concat(str, crStr, 'depth=', long2str(depth));
  698.                         str := concat(str, crStr, 'planes=', long2str(planes));
  699.                         str := concat(str, crStr, 'rowBytes=', long2str(rowBytes));
  700.                         str := concat(str, crStr, 'loPlane=', long2str(loPlane));
  701.                         str := concat(str, crStr, 'hiPlane=', long2str(hiPlane));
  702.                         ShowMessage(str);
  703.                     end;
  704.         end;
  705.  
  706.         function BadRect: boolean;
  707.         begin
  708.             BadRect := false;
  709.             with info^.PicRect do begin
  710.                     if (ExportRec.theRect.left < left) or (exportRec.theRect.right > right) or (exportRec.theRect.top < top) or (exportRec.theRect.bottom > bottom) then
  711.                         BadRect := true;
  712.                 end;
  713.         end;
  714.  
  715.         procedure abort (result: integer);
  716.         begin
  717.             CloseResFile(RefNum);
  718.             if MeterWindow <> nil then begin
  719.                     DisposeWindow(MeterWindow);
  720.                     MeterWindow := nil;
  721.                 end;
  722.             InvertPic;
  723.             if result < 0 then
  724.                 PutError(concat('Plug-in error (result code=', long2str(result), ').'));
  725.             {exit(LoadExportPlugIn);} {ppc-bug}
  726.         end;
  727.  
  728.     begin
  729.         if not isSystem7 then
  730.             exit(LoadExportPlugIn);
  731.         SetRect(empty, 0, 0, 0, 0);
  732.         with info^ do
  733.             if RoiShowing then
  734.                 roi := RoiRect
  735.             else
  736.                 roi := empty;
  737.         ShowProgress := true;
  738.         codePtr := nil;
  739.         LoadCodeResource(FileName, '8BEM', codePtr);
  740.         if codePtr = nil then
  741.             exit(LoadExportPlugIn);
  742.         if TestAbortProc=nil then
  743.             TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA);
  744.         if UpdateProgressProc=nil then 
  745.             UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA);
  746.         InvertPic;
  747.         with ExportRec, info^ do begin
  748.                 SerialNumber := 12345;
  749.                 AbortProc := TestAbortProc;
  750.                 ProgressProc := UpdateProgressProc;
  751.                 MaxData := maxBlock div 2;
  752.                 if MaxData < 25000 then begin
  753.                         PutError('Out of memory.');
  754.                         abort(0);
  755.                         exit(LoadExportPlugIn);
  756.                     end;
  757.                 if LUTMode = Grayscale then
  758.                     ImageMode := GrayScaleMode
  759.                 else
  760.                     ImageMode := IndexedColorMode;
  761.                 with PicRect, eImageSize do begin
  762.                         h := right - left;
  763.                         v := bottom - top;
  764.                     end;
  765.                 depth := 8;
  766.                 planes := 1;
  767.                 imageHRes := bsl(72, 16);
  768.                 imageVRes := imageHRes;
  769.                 for i := 0 to 255 do
  770.                     with cTable[i].rgb do begin
  771.                             rLUT[255 - i] := chr(bsr(red, 8));
  772.                             gLUT[255 - i] := chr(bsr(green, 8));
  773.                             bLUT[255 - i] := chr(bsr(blue, 8));
  774.                         end;
  775.                 theRect := empty;
  776.                 loPlane := 0;
  777.                 hiPlane := 0;
  778.                 data := PicBaseAddr;
  779.                 rowBytes := BytesPerRow;
  780.                 FileName := title;
  781.                 vRefNum := vRef;
  782.                 dirty := changes;
  783.                 selectBBox := roi;
  784.                 hostSig := 'Imag';
  785.                 hostProc := nil; {@DummyProc}
  786.                 duoToneInfo := nil;
  787.                 thePlane := 0;
  788.                 monitor.gamma := 0;
  789.                 for i := 0 to 255 do
  790.                     reserved[i] := chr(0);
  791.             end;
  792.         ProgressMsg := 'Exporting Image…';
  793.         CallCode(ExportPrepare, @ExportRec, ExportData, result, codePtr);
  794.         if (result <> 0) then begin
  795.             abort(result);
  796.             exit(LoadExportPlugIn);
  797.         end;
  798.         CallCode(ExportStart, @ExportRec, ExportData, result, codePtr);{call main dialog box etc.}
  799.         if (result <> 0) then begin
  800.             abort(result);
  801.             exit(LoadExportPlugIn);
  802.         end;
  803.         ShowWatch;
  804.         repeat
  805.             if BadRect then begin
  806.                 abort(0);
  807.                 exit(LoadExportPlugIn);
  808.             end;
  809.             with ExportRec, info^ do begin
  810.                     offset := theRect.top * BytesPerRow + theRect.left;
  811.                     data := ptr(ord4(PicBaseAddr) + offset);
  812.                 end;
  813.             CallCode(exportContinue, @exportRec, exportData, result, codePtr);
  814.         until (result <> 0) or EmptyRect(exportRec.theRect);
  815.         CallCode(ExportFinish, @ExportRec, ExportData, result, codePtr);
  816.         CloseResFile(RefNum);
  817.         if MeterWindow <> nil then begin
  818.                 DisposeWindow(MeterWindow);
  819.                 MeterWindow := nil;
  820.             end;
  821.         InvertPic;
  822.     end;
  823.  
  824.  
  825.     procedure RunExportPlugIn (item: integer);
  826.         var
  827.             name: str255;
  828.     begin
  829.         if nExportPlugIns = 0 then begin
  830.                 PutPlugInMsg('No export');
  831.                 exit(RunExportPlugIn);
  832.             end;
  833.         GetMenuItemText(ExportMenuH, item, name);
  834.         LoadExportPlugIn(name);
  835.     end;
  836.  
  837.  
  838.     procedure LoadFilterPlugIn (FileName: str255);
  839.  
  840.         const
  841.             filterAbout = 0;
  842.             filterParameters = 1;
  843.             filterPrepare = 2;
  844.             filterStart = 3;
  845.             filterContinue = 4;
  846.             filterFinish = 5;
  847.  
  848.             GrayScaleMode = 1;
  849.  
  850.         var
  851.             thiserror: qderr;
  852.             codePtr: ProcPtr;
  853.             result, i, selector, width, height: integer;
  854.             ok: boolean;
  855.             dst: ptr;
  856.             Empty, roi: rect;
  857.             offset: LongInt;
  858.  
  859.         procedure InvertUndoPic;
  860.             var
  861.                 tPort: GrafPtr;
  862.                 SaveGDevice: GDHandle;
  863.         begin
  864.             SaveGDevice := GetGDevice;
  865.             SetGDevice(osGDevice);
  866.             GetPort(tPort);
  867.             with UndoInfo^ do begin
  868.                     SetPort(GrafPtr(osPort));
  869.                     InvertRect(PicRect);
  870.                 end;
  871.             SetPort(tPort);
  872.             SetGDevice(SaveGDevice);
  873.         end;
  874.  
  875.         procedure abort;
  876.         begin
  877.             CloseResFile(RefNum);
  878.             InvertPic;
  879.             InvertUndoPic;
  880.             if MeterWindow <> nil then begin
  881.                     DisposeWindow(MeterWindow);
  882.                     MeterWindow := nil;
  883.                 end;
  884.             {exit(LoadFilterPlugIn);} {ppc-bug}
  885.         end;
  886.  
  887.         function BadRect: boolean;
  888.         begin
  889.             BadRect := false;
  890.             with info^.PicRect do begin
  891.                     if (FilterRec.inRect.left < left) or (FilterRec.inRect.right > right) or (FilterRec.inRect.top < top) or (FilterRec.inRect.bottom > bottom) then
  892.                         BadRect := true;
  893.                     if (FilterRec.outRect.left < left) or (FilterRec.outRect.right > right) or (FilterRec.outRect.top < top) or (FilterRec.outRect.bottom > bottom) then
  894.                         BadRect := true;
  895.                 end;
  896.         end;
  897.  
  898.     begin {LoadFilterPlugIn}
  899.         if not isSystem7 then
  900.             exit(LoadFilterPlugIn);
  901.         if macro then
  902.             if FileName = 'Reset' then begin
  903.                     FilterRec.parameters := nil;
  904.                     exit(LoadFilterPlugIn);
  905.                 end;
  906.         if NotInBounds or NoUndo or NotRectangular then
  907.             exit(LoadFilterPlugIn);
  908.         with info^ do
  909.             if RoiShowing then
  910.                 roi := RoiRect
  911.             else
  912.                 roi := PicRect;
  913.         KillRoi;
  914.         SetupUndo;
  915.         SetupUndoInfoRec;
  916.         InvertPic;
  917.         InvertUndoPic;
  918.         WhatToUndo := UndoFilter;
  919.         ShowProgress := true;
  920.         codePtr := nil;
  921.         LoadCodeResource(FileName, '8BFM', codePtr);
  922.         if codePtr = nil then
  923.             exit(LoadFilterPlugIn);
  924.         if TestAbortProc=nil then
  925.             TestAbortProc := NewRoutineDescriptor(@TestAbort, uppTestAbortProcInfo, GetCurrentISA);
  926.         if UpdateProgressProc=nil then 
  927.             UpdateProgressProc := NewRoutineDescriptor(@UpdateProgress, uppUpdateProgressProcInfo, GetCurrentISA);
  928.         SetRect(Empty, 0, 0, 0, 0);
  929.         with FilterRec, info^ do begin
  930.                 serialnumber := 12345;
  931.                 AbortProc := TestAbortProc;
  932.                 ProgressProc := UpdateProgressProc;
  933.                 with PicRect, fImageSize do begin
  934.                         h := right - left;
  935.                         v := bottom - top;
  936.                     end;
  937.                 planes := 1;
  938.                 filterRect := roi;
  939.                 background := BlackRGB;
  940.                 foreground := WhiteRGB;
  941.                 maxSpace := PixMapSize;
  942.                 bufferSpace := 0;
  943.                 inRect := Empty;
  944.                 inLoPlane := 0;
  945.                 inHiPlane := 0;
  946.                 outRect := Empty;
  947.                 outLoPlane := 0;
  948.                 outHiPlane := 0;
  949.                 inData := UndoBuf;
  950.                 inRowBytes := BytesPerRow;
  951.                 outData := PicBaseAddr;
  952.                 outRowBytes := BytesPerRow;
  953.                 isFloating := false;
  954.                 haveMask := false;
  955.                 autoMask := false;
  956.                 maskRect := Empty;
  957.                 maskData := nil;
  958.                 maskRowBytes := BytesPerRow;
  959.                 for i := 0 to 3 do begin
  960.                         backColor[i] := chr(255 - BackgroundIndex);
  961.                         foreColor[i] := chr(255 - ForegroundIndex);
  962.                     end;
  963.                 hostSig := 'Imag';
  964.                 hostProc := nil; {@DummyProc}
  965.                 imageMode := GrayScaleMode;
  966.                 imageHRes := bsl(72, 16);
  967.                 imageVRes := imageHRes;
  968.                 floatCoord.h := 0;
  969.                 floatCoord.v := 0;
  970.                 wholeSize := fImageSize;
  971.                 monitor.gamma := 0;
  972.                 for i := 0 to 255 do
  973.                     reserved[i] := chr(0);
  974.             end;
  975.         ProgressMsg := 'Filtering Image…';
  976.         if not (macro and (FilterRec.parameters <> nil)) then begin
  977.                 CallCode(FilterParameters, @FilterRec, filterData, result, codePtr);
  978.                 if result <> 0 then begin
  979.                     abort;
  980.                     exit(LoadFilterPlugIn);
  981.                 end;
  982.             end;
  983.         CallCode(FilterPrepare, @FilterRec, filterData, result, codePtr);
  984.         if result <> 0 then begin
  985.             abort;
  986.             exit(LoadFilterPlugIn);
  987.         end;
  988.         if FilterRec.bufferSpace > (MaxBlock + MinFree) then begin
  989.                 PutError('Not enough memory to run filter.');
  990.                 abort;
  991.                 exit(LoadFilterPlugIn);
  992.             end;
  993.         CallCode(FilterStart, @FilterRec, filterData, result, codePtr);
  994.         if result <> 0 then begin
  995.             abort;
  996.             exit(LoadFilterPlugIn);
  997.         end;
  998.         ShowWatch;
  999.         repeat
  1000.             if BadRect then begin
  1001.                 abort;
  1002.                 exit(LoadFilterPlugIn);
  1003.             end;
  1004.             with FilterRec, info^ do begin
  1005.                     offset := inRect.top * BytesPerRow + inRect.left;
  1006.                     inData := ptr(ord4(UndoBuf) + offset);
  1007.                     offset := outRect.top * BytesPerRow + outRect.left;
  1008.                     outData := ptr(ord4(PicBaseAddr) + offset);
  1009.                 end;
  1010.             CallCode(filterContinue, @FilterRec, filterData, result, codePtr);
  1011.         until (result <> 0) or (EmptyRect(FilterRec.inRect) and EmptyRect(FilterRec.outRect));
  1012.         CallCode(filterFinish, @FilterRec, filterData, result, codePtr);
  1013.         CloseResFile(RefNum);
  1014.         if MeterWindow <> nil then begin
  1015.                 DisposeWindow(MeterWindow);
  1016.                 MeterWindow := nil;
  1017.             end;
  1018.         InvertPic;
  1019.         InvertUndoPic;
  1020.         UpdatePicWindow;
  1021.         info^.changes := true;
  1022.     end;
  1023.  
  1024.  
  1025.     procedure RunFilterPlugIn (item: integer);
  1026.         var
  1027.             name: str255;
  1028.     begin
  1029.         if nFilterPlugIns = 0 then begin
  1030.                 PutPlugInMsg('No filter');
  1031.                 exit(RunFilterPlugIn);
  1032.             end;
  1033.         GetMenuItemText(FilterMenuH, item, name);
  1034.         LoadFilterPlugIn(name);
  1035.     end;
  1036.  
  1037.  
  1038. end.